
 1000  *SAVE S.DP18 FOUT
 1010  *--------------------------------
 1020  AS.COUT       .EQ $DB5C
 1030  DADD          .EQ $FFFF
 1040  MOVE.YA.ARG   .EQ $FFFF
 1050  *--------------------------------
 1060  FOUT.BUF      .BS 41
 1070  FOUT.BUF.SIZE .EQ *-FOUT.BUF
 1080  *--------------------------------
 1090  W          .BS 1
 1100  D          .BS 1
 1110  INDEX      .BS 1
 1120  SIGN.SIZE  .BS 1
 1130  SIGN.CHAR  .BS 1
 1140  ZERO.CHAR  .BS 1
 1150  WW         .BS 1
 1160  DD         .BS 1
 1170  DIGIT.PICKER        .BS 1
 1180  NO.LEADING.ZEROES   .BS 1
 1190  NO.LEADING.DIGITS   .BS 1
 1200  NO.INTEGRAL.ZEROES  .BS 1
 1210  NO.LEADING.BLANKS   .BS 1
 1220  *--------------------------------
 1230  DAC           .BS 12
 1240  DAC.EXPONENT  .EQ DAC
 1250  DAC.HI        .EQ DAC+1
 1260  DAC.EXTENSION .EQ DAC+10
 1270  DAC.SIGN      .EQ DAC+11
 1280  *--------------------------------
 1290  ARG           .BS 12
 1300  ARG.EXPONENT  .EQ ARG
 1310  ARG.HI        .EQ ARG+1
 1320  ARG.EXTENSION .EQ ARG+10
 1330  ARG.SIGN      .EQ ARG+11
 1340  *--------------------------------
 1350  *   QUICK PRINT
 1360  *--------------------------------
 1370  QUICK.PRINT
 1380         JSR QUICK.FOUT
 1390         JMP FOR.PRINT.1
 1400  *--------------------------------
 1410  *   FORMATTED PRINT
 1420  *      (A)=WIDTH OF FIELD
 1430  *      (Y)=# OF FRACTIONAL DIGITS
 1440  *--------------------------------
 1450  FORMAT.PRINT
 1460         LDX #'0      USE ZEROES BEFORE FRACTION
 1470         STX ZERO.CHAR
 1480         JSR FOUT
 1490  *--------------------------------
 1500  FOR.PRINT.1
 1510         LDY #0
 1520  .1     LDA FOUT.BUF,Y
 1530         BEQ .2
 1540         JSR AS.COUT
 1550         INY
 1560         BNE .1       ...ALWAYS
 1570  .2     RTS
 1580  *--------------------------------
 1590  *      QUICK CONVERSION
 1600  *--------------------------------
 1610  QUICK.FOUT
 1620         LDY #0
 1630         STY INDEX
 1640         LDA DAC.EXPONENT
 1650         BNE .0       NUMBER IS NOT ZERO
 1660         INC INDEX
 1670         STY FOUT.BUF+1
 1680         LDA #'0
 1690         STA FOUT.BUF  MAKE IT '0'
 1700         RTS
 1710  .0     LDA DAC.SIGN
 1720         BPL .1
 1730         LDA #'-      NEGATIVE
 1740         JSR STORE.CHAR
 1750  *--------------------------------
 1760  .1     LDA DAC.HI,Y NEXT BYTE OF #
 1770         PHA
 1780         LSR
 1790         LSR
 1800         LSR
 1810         LSR
 1820         JSR STORE.DIGIT
 1830         CPY #0
 1840         BNE .2
 1850         LDA #'.      PUT DECIMAL POINT
 1860         JSR STORE.CHAR
 1870  .2     PLA          DO 2ND DIGIT
 1880         JSR STORE.DIGIT
 1890         INY
 1900         CPY #9       8 MORE BYTES
 1910         BCC .1
 1920  *--------------------------------
 1930         LDY INDEX    TRUNCATE TRAILING ZEROS
 1940  .3     DEY
 1950         LDA FOUT.BUF,Y
 1960         CMP #'0
 1970         BEQ .3       DONE
 1980         CMP #'.      TRAILING DECIMAL PT?
 1990         BNE .4       NO
 2000         DEY          YES, DELETE IT
 2010  .4     INY
 2020         STY INDEX    SAVE NEW END OF NUMBER
 2030  *--------------------------------
 2040         LDA #'E
 2050         JSR STORE.CHAR E FOR EXPONENT
 2060         LDA #'+
 2070         LDY DAC.EXPONENT
 2080         DEY
 2090         CPY #$40
 2100         BCS .5
 2110         LDA #'-
 2120  .5     JSR STORE.CHAR
 2130         TYA          EXPONENT
 2140         SEC
 2150         SBC #$40     REMOVE OFFSET
 2160         BPL .6
 2170         EOR #$FF
 2180         ADC #1
 2190  .6     LDX #'0-1
 2200         SEC
 2210  .8     INX
 2220         SBC #10
 2230         BCS .8
 2240         ADC #'9+1
 2250         PHA
 2260         TXA
 2270         JSR STORE.CHAR
 2280         PLA
 2290         JSR STORE.CHAR
 2300         LDA #0
 2310         JMP STORE.CHAR
 2320  *--------------------------------
 2330  *   FORMATTED CONVERSION
 2340  *      (A)=WIDTH OF FIELD
 2350  *      (Y)=# OF FRACTIONAL DIGITS
 2360  *--------------------------------
 2370  FOUT
 2380         CMP #FOUT.BUF.SIZE    LIMIT WIDTH
 2390         BCC .1
 2400         LDA #FOUT.BUF.SIZE-1
 2410  .1     STA W
 2420         CPY W        FORCE D<W
 2430         BCC .2
 2440         TAY
 2450         DEY
 2460  .2     STY D
 2470  *--------------------------------
 2480         LDA #0
 2490         STA INDEX
 2500         STA SIGN.SIZE
 2510         STA SIGN.CHAR
 2520         STA NO.INTEGRAL.ZEROES
 2530         STA NO.LEADING.ZEROES
 2540         STA DIGIT.PICKER
 2550  *--------------------------------
 2560         JSR ROUND.DAC.D   ROUND TO D DIGITS
 2570         LDA DAC.SIGN
 2580         BPL .3
 2590         INC SIGN.SIZE
 2600         LDA #'-      MINUS SIGN
 2610         STA SIGN.CHAR
 2620  *--------------------------------
 2630  .3     SEC
 2640         LDA DAC.EXPONENT
 2650         SBC #$40     REMOVE OFFSET
 2660         BPL .4
 2670         EOR #$FF
 2680         STA NO.LEADING.ZEROES
 2690         INC NO.LEADING.ZEROES
 2700         LDA #0
 2710  .4     STA NO.LEADING.DIGITS
 2720  *--------------------------------
 2730         SEC
 2740         LDA NO.LEADING.DIGITS
 2750         SBC #18
 2760         BMI .5
 2770         STA NO.INTEGRAL.ZEROES
 2780         LDA #18      18 SIGNIF DIGITS MAX
 2790         STA NO.LEADING.DIGITS
 2800  *--------------------------------
 2810  .5     CLC          CALCULATE TOTAL # OF DIGITS
 2820         LDA SIGN.SIZE
 2830         ADC NO.LEADING.DIGITS
 2840         ADC NO.INTEGRAL.ZEROES
 2850         ADC D
 2860         ADC #1
 2870         STA WW
 2880  *--------------------------------
 2890         SEC
 2900         LDA D
 2910         SBC NO.LEADING.ZEROES
 2920         STA DD
 2930  *--------------------------------
 2940         SEC
 2950         LDA W
 2960         SBC WW
 2970         BMI .14      ...OVERFLOW
 2980         STA NO.LEADING.BLANKS
 2990         LDA NO.LEADING.DIGITS
 3000         BNE .6
 3010         DEC NO.LEADING.BLANKS
 3020         BPL .6
 3030         INC NO.LEADING.BLANKS IT WENT -, MAKE 0
 3040  *---STORE LEADING BLANKS---------
 3050  .6     LDA #' '     BLANK
 3060         LDY NO.LEADING.BLANKS
 3070         JSR STORE.N.CHARS
 3080  *---STORE SIGN-------------------
 3090         LDA SIGN.CHAR
 3100         BEQ .8
 3110         JSR STORE.CHAR
 3120  *---STORE INTEGRAL DIGITS--------
 3130  .8     LDY NO.LEADING.DIGITS
 3140         BEQ .10
 3150         JSR STORE.N.DIGITS
 3160         BEQ .11      ...ALWAYS
 3170  .10    LDA ZERO.CHAR  NO INTEGER PART,SO PRINT 0
 3180         JSR STORE.CHAR
 3190  .11    LDA #'0
 3200         LDY NO.INTEGRAL.ZEROES
 3210         JSR STORE.N.CHARS
 3220  *---STORE FRACTION---------------
 3230         LDA #'.
 3240         JSR STORE.CHAR
 3250         LDA DD
 3260         ORA NO.LEADING.ZEROES
 3270         BEQ .13
 3280         LDA ZERO.CHAR
 3290         LDY NO.LEADING.ZEROES
 3300         JSR STORE.N.CHARS
 3310         LDY DD
 3320         JSR STORE.N.DIGITS
 3330  *---TERMINATE STRING-------------
 3340  .13    LDA #0
 3350         JMP STORE.CHAR
 3360  *--------------------------------
 3370  .14    LDA #'*'     FILL FIELD WITH STARS
 3380         LDY W
 3390         JSR STORE.N.CHARS
 3400         JMP .13
 3410  *--------------------------------
 3420  *   STORE NEXT (Y) DIGITS
 3430  *--------------------------------
 3440  SND..1 LDA DIGIT.PICKER
 3450         CMP #20
 3460         BCC .1
 3470         LDA #0
 3480         BEQ .2       ...ALWAYS
 3490  .1     LSR          LEFT/RIGHT --> C
 3500         TAX          INDEX --> X
 3510         INC DIGIT.PICKER
 3520         LDA DAC.HI,X
 3530         BCS .2
 3540         LSR
 3550         LSR
 3560         LSR
 3570         LSR
 3580  .2     JSR STORE.DIGIT
 3590         DEY
 3600  STORE.N.DIGITS
 3610         BNE SND..1
 3620         RTS
 3630  *--------------------------------
 3640  *   STORE (Y) OF THE CHARACTER IN (A)
 3650  *      (Z-STATUS IF COUNT IS 0)
 3660  *--------------------------------
 3670  SNC..1 JSR STORE.CHAR
 3680         DEY
 3690  STORE.N.CHARS
 3700         BNE SNC..1
 3710         RTS
 3720  *--------------------------------
 3730  *      STORE A CHAR IN THE BUFFER
 3740  *--------------------------------
 3750  STORE.DIGIT
 3760         AND #$0F
 3770         ORA #'0'
 3780  STORE.CHAR
 3790         LDX INDEX
 3800         STA FOUT.BUF,X
 3810         INC INDEX
 3820         RTS
 3830  *--------------------------------
 3840  *      ROUND DAC TO (D) DECIMAL PLACES
 3850  *--------------------------------
 3860  ROUND.DAC.D
 3870         LDA DAC.SIGN  GET THE SIGN
 3880         PHA          SAVE IT
 3890         LDA #CON.1HALF
 3900         LDY /CON.1HALF
 3910         JSR MOVE.YA.ARG   MOVE .5*10^-D INTO ARG
 3920         PLA          GET SIGN
 3930         STA ARG.SIGN
 3940         LDA D        GET # OF PLACES
 3950         EOR #$FF     MAKE IT NEGATIVE BY 2S COMPLEMENT
 3960         SEC          ADD 1 DURING NEXT ADD
 3970         ADC #$40     ADD OFFSET
 3980         STA ARG.EXPONENT
 3990         JMP DADD     ADD .5*10^-D;FOUT WILL TRUNCATE IT
 4000  *--------------------------------
 4010  CON.1HALF .HS 4050000000000000000000

